home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / fft / FFT.ZIP / SAMPLE / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-04-15  |  6.1 KB  |  218 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, ComCtrls, FastFour;
  8.  
  9. type
  10.   TFormMain = class(TForm)
  11.     Panel1: TPanel;
  12.     Panel2: TPanel;
  13.     Panel3: TPanel;
  14.     RadioGroupInitData: TRadioGroup;
  15.     GroupBox1: TGroupBox;
  16.     Label1: TLabel;
  17.     Label2: TLabel;
  18.     Label3: TLabel;
  19.     TrackBarLow: TTrackBar;
  20.     TrackBarHigh: TTrackBar;
  21.     TrackBarNoise: TTrackBar;
  22.     ButtonReset: TButton;
  23.     ButtonClose: TButton;
  24.     PaintBoxCenter: TPaintBox;
  25.     PaintBoxTop: TPaintBox;
  26.     Panel4: TPanel;
  27.     Label4: TLabel;
  28.     Label5: TLabel;
  29.     Panel5: TPanel;
  30.     Label6: TLabel;
  31.     Label7: TLabel;
  32.     FastFourier1: TFastFourier;
  33.     procedure ButtonCloseClick(Sender: TObject);
  34.     procedure PaintBoxTopPaint(Sender: TObject);
  35.     procedure PaintBoxCenterPaint(Sender: TObject);
  36.     procedure TrackBarLowChange(Sender: TObject);
  37.     procedure TrackBarHighChange(Sender: TObject);
  38.     procedure TrackBarNoiseChange(Sender: TObject);
  39.     procedure ButtonResetClick(Sender: TObject);
  40.     procedure RadioGroupInitDataClick(Sender: TObject);
  41.     procedure FastFourier1GetValue(Sender: TObject; Index: LongInt;
  42.       ComplexPart: TComplexNumPart; var Value: Double);
  43.     procedure FormCreate(Sender: TObject);
  44.   private
  45.     Randoms: array[1..8192] of Double;
  46.   public
  47.     { Public declarations }
  48.   end;
  49.  
  50. var
  51.   FormMain: TFormMain;
  52.  
  53. implementation
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TFormMain.FormCreate(Sender: TObject);
  58. var
  59.   i: Integer;
  60.   style: longint;
  61. begin
  62.   style := GetWindowLong(TrackBarLow.Handle,GWL_STYLE) and (not 32);
  63.   SetWindowLong(TrackBarLow.Handle,GWL_STYLE,style);
  64.   SetWindowLong(TrackBarHigh.Handle,GWL_STYLE,style);
  65.   SetWindowLong(TrackBarNoise.Handle,GWL_STYLE,style);
  66.  
  67.   for i := 1 to 8192 do
  68.     Randoms[i] := random-0.5;
  69.  
  70.   FastFourier1.DoFourier;
  71.   FastFourier1.DoInverse;
  72.   PaintBoxTop.Invalidate;
  73.   PaintBoxCenter.Invalidate;
  74. end;
  75.  
  76.  
  77. procedure TFormMain.ButtonCloseClick(Sender: TObject);
  78. begin
  79.   Close;
  80. end;
  81.  
  82. procedure TFormMain.PaintBoxTopPaint(Sender: TObject);
  83. var
  84.   x,y,i: LongInt;
  85.   w: Integer;
  86. begin
  87.   PaintBoxTop.Canvas.Brush.Color := clRed;
  88.   x := PaintBoxTop.Width div FastFourier1.Length;
  89.   w := x;
  90.   for i := 1 to FastFourier1.Length div 2 do
  91.     begin
  92.       y := Round(PaintBoxTop.Height - PaintBoxTop.Height*0.9*FastFourier1.Spectrum[i]);
  93.       PaintBoxTop.Canvas.Rectangle(x,y,x+w,PaintBoxTop.Height);
  94.       x := x + w;
  95.     end;
  96.  
  97.   PaintBoxTop.Canvas.Brush.Color := clYellow;
  98.   x := PaintBoxTop.Width div FastFourier1.Length;
  99.   for i := 1 to FastFourier1.Length div 2 do
  100.     begin
  101.       y := Round(PaintBoxTop.Height div 2 - PaintBoxTop.Height*0.9*FastFourier1.TransformedSpectrum[i]);
  102.       PaintBoxTop.Canvas.Rectangle(x,y,x+w,PaintBoxTop.Height div 2);
  103.       x := x + w;
  104.     end;
  105. end;
  106.  
  107. procedure TFormMain.PaintBoxCenterPaint(Sender: TObject);
  108. var
  109.   x,y,i: LongInt;
  110.   value: Double;
  111. begin
  112.   PaintBoxCenter.Canvas.Pen.Color := clRed;
  113.   FastFourier1GetValue(self,1,cpRe,Value);
  114.   x := Round(PaintBoxCenter.Width/FastFourier1.Length);
  115.   y := Round(PaintBoxCenter.Height/2 + PaintBoxCenter.Height/2*Value);
  116.   PaintBoxCenter.Canvas.MoveTo(x,y);
  117.   for i := 2 to FastFourier1.Length do
  118.     begin
  119.       FastFourier1GetValue(self,i,cpRe,value);
  120.       x := Round(PaintBoxCenter.Width/FastFourier1.Length*i);
  121.       y := Round(PaintBoxCenter.Height/2 + PaintBoxCenter.Height/2*Value);
  122.       PaintBoxCenter.Canvas.LineTo(x,y);
  123.     end;
  124.  
  125.   PaintBoxCenter.Canvas.Pen.Color := clYellow;
  126.   x := Round(PaintBoxCenter.Width/FastFourier1.Length);
  127.   y := Round(PaintBoxCenter.Height/2 + PaintBoxCenter.Height/2*FastFourier1.Inverse[1,cpRe]);
  128.   PaintBoxCenter.Canvas.MoveTo(x,y);
  129.   for i := 2 to FastFourier1.Length do
  130.     begin
  131.       x := Round(PaintBoxCenter.Width/FastFourier1.Length*i);
  132.       y := Round(PaintBoxCenter.Height/2 + PaintBoxCenter.Height/2*FastFourier1.Inverse[i,cpRe]);
  133.       PaintBoxCenter.Canvas.LineTo(x,y);
  134.     end;
  135. end;
  136.  
  137.  
  138. procedure TFormMain.TrackBarLowChange(Sender: TObject);
  139. begin
  140.   FastFourier1.LowCut := TrackBarLow.Position;
  141.   FastFourier1.DoInverse;
  142.   PaintBoxTop.Invalidate;
  143.   PaintBoxCenter.Invalidate;
  144. end;
  145.  
  146. procedure TFormMain.TrackBarHighChange(Sender: TObject);
  147. begin
  148.   FastFourier1.HighCut := TrackBarHigh.Position;
  149.   FastFourier1.DoInverse;
  150.   PaintBoxTop.Invalidate;
  151.   PaintBoxCenter.Invalidate;
  152. end;
  153.  
  154. procedure TFormMain.TrackBarNoiseChange(Sender: TObject);
  155. begin
  156.   FastFourier1.Noise := TrackBarNoise.Position;
  157.   FastFourier1.DoInverse;
  158.   PaintBoxTop.Invalidate;
  159.   PaintBoxCenter.Invalidate;
  160. end;
  161.  
  162.  
  163. procedure TFormMain.ButtonResetClick(Sender: TObject);
  164. var
  165.   i: Integer;
  166. begin
  167.   for i := 1 to 8192 do
  168.     Randoms[i] := random-0.5;
  169.  
  170.   FastFourier1.DoFourier;
  171.   FastFourier1.DoInverse;
  172.   PaintBoxTop.Invalidate;
  173.   PaintBoxCenter.Invalidate;
  174. end;
  175.  
  176. procedure TFormMain.RadioGroupInitDataClick(Sender: TObject);
  177. begin
  178.   FastFourier1.DoFourier;
  179.   FastFourier1.DoInverse;
  180.   PaintBoxTop.Invalidate;
  181.   PaintBoxCenter.Invalidate;
  182. end;
  183.  
  184. procedure TFormMain.FastFourier1GetValue(Sender: TObject; Index: LongInt;
  185.   ComplexPart: TComplexNumPart; var Value: Double);
  186. begin
  187.   case RadioGroupInitData.ItemIndex of
  188.     0: // Base
  189.       if ComplexPart = cpRe then
  190.         Value := 0.5 * sin(Index/16) + 0.4*sin(Index/4) + 0.1 * Randoms[1+(Index mod 8192)]
  191.       else
  192.         Value := 0;
  193.     1: //     /\/\
  194.       if ComplexPart = cpRe then
  195.         if (Index mod 16)>7 then
  196.           Value := (1 - (Index mod 16)/8)*0.9+0.1*Randoms[1+(Index mod 8192)]
  197.         else
  198.           Value := ((Index mod 16)/8-1)*0.9+0.1*Randoms[1+(Index mod 8192)]
  199.       else
  200.         Value := 0;
  201.     2: //     _-_-_
  202.       if ComplexPart = cpRe then
  203.         if (Index mod 10)>4 then
  204.           Value := -0.9+0.1*Randoms[1+(Index mod 8192)]
  205.         else
  206.           Value := 0.9+0.1*Randoms[1+(Index mod 8192)]
  207.       else
  208.         Value := 0;
  209.     3: //   / / / /
  210.       if ComplexPart = cpRe then
  211.         Value := ((Index mod 10)/10-0.5)*0.9+0.1*Randoms[1+(Index mod 8192)]
  212.       else
  213.         Value := 0;
  214.   end;
  215. end;
  216.  
  217. end.
  218.